home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
tdk_v120.zip
/
TEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-07-15
|
10KB
|
212 lines
{
▀▀▀▀▀▀▀▀ ▀▀▀▀▀▀ ▀▀ ▀▀
▀▀ ▀▀ ▀▀ ▀▀ ▀▀
▀▀ ▀▀ ▀▀▀ ▀▀▀▀▀ The DoorKit!
▀▀ ▀▀ ▀▀ ▀▀ ▀▀
▀▀ ▀▀▀▀▀▀ ▀▀ ▀▀
The BBS Door Development Kit By The People - For The People!
Feel free to modify or optimize this code at will. All I ask is that if
find a better way to do things (and you will), please send me a copy of
your modifications. Thanks in advance!....Larry L. Athey....}
{ Adjust your compiler directives as you see fit }
{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 65520,0,655360}
Program TEST;
USES _EXIT, DOORKIT1, DOORKIT2, CRT; {The bare minimum of unit declarations..}
{Make note of the order of declarations.}
VAR {Note: CRT is not required in all doors.}
Str : STRING;
Ch : CHAR;
X : BYTE;
Y : BYTE;
MinX : BYTE;
MinY : BYTE;
MaxX : BYTE;
MaxY : BYTE;
Loop : BYTE;
Quit : BOOLEAN;
BEGIN
{--------------------------------------------------------------------------}
{ This is all that is needed to initialize your door program...You may add }
{ more variable/constant modifications at your own discretion... }
{--------------------------------------------------------------------------}
ProgramName := 'TEST.EXE Version -9.02E+16';
ProgramDesc := 'Example Door Program For "The DoorKit"';
{--------------------------------------------------------------------------}
{ After you have made all of your variable/constant modifications, you can }
{ initialize or "Start Up" your door program... }
{--------------------------------------------------------------------------}
InitDoorKit;
{--------------------------------------------------------------------------}
REPEAT
sWriteln(''); InfoText('Please Select A Function:'); sWriteln('');
LineBar(1,0,33);
CPrompt('A',' Display An ANSI Screen File'); sWriteln('');
CPrompt('B',' Display A Text File'); sWriteln('');
CPrompt('C',' Test An Entry Field'); sWriteln('');
CPrompt('D',' Display A Window'); sWriteln('');
CPrompt('E',' Run An Entry Form Script'); sWriteln('');
CPrompt('F',' Simulate Drop Down Menus'); sWriteln('');
CPrompt('G',' Test Cursor Control Keys'); sWriteln('');
CPrompt('Q',' Quit/Exit The Demo Program'); sWriteln('');
LineBar(1,0,33);
FancyPrompt;
Ch := UPCASE(sReadKey); sWriteln('');
CASE Ch OF
'A' : BEGIN
ShowScreen('BBS-UTIL.ANS');
AnyKey;
END;
'B' : ShowTextFile('DOORKIT.DOC');
'C' : BEGIN
sWriteln('');
OutTxt(11,0,'Enter Some Text: ');
IF Graphics = TTY THEN Str := NormalInput(50,'')
ELSE Str := NormalPrompt(50,'');
Str := CvtVars(Str); {Check For Variables}
sWriteln('');
Set_Color(10,0);
CvtColors('You Entered: {14}'+Str,TRUE); {Converts Colors}
sWriteln('');
AnyKey;
END;
'D' : IF Graphics <> TTY Then BEGIN
sClrScr;
OutTxtL(10,0,'Since this procedure uses specific X / Y coordinates, the caller must have');
OutTxtL(10,0,'ANSI graphics capabilities. TTY/ASCII callers would see nothing but garbage');
OutTxtL(10,0,'on their screen. This is the reason for the "IF Graphics <> TTY THEN BEGIN"');
DrawWin(5,5,74,19, 'This Is An Example Window');
OutTxtXY(7,7,11,1, ' Enter Your Name:'); DummyField(27,7,40,'');
OutTxtXY(7,8,11,1, ' Enter Your Address:'); DummyField(27,8,40,'');
OutTxtXY(7,9,11,1, ' Enter Your City:'); DummyField(27,9,20,'');
OutTxtXY(7,10,11,1,' Enter Your State:'); DummyField(27,10,20,'');
OutTxtXY(7,11,11,1,'Enter Your Zip Code:'); DummyField(27,11,12,'');
OutTxtXY(7,12,11,1,' Voice Phone Number:'); DummyField(27,12,12,'');
OutTxtXY(7,13,11,1,' Data Phone Number:'); DummyField(27,13,12,'');
SysButton(56,15,'S','ave');
SysButton(65,15,'Q','uit');
Str := SysField(27,7,2,40,'');
Str := SysField(27,8,2,40,'');
Str := SysField(27,9,2,20,'');
Str := SysField(27,10,2,20,'');
Str := SysField(27,11,1,12,'');
Str := SysField(27,12,1,12,'');
Str := SysField(27,13,1,12,'');
OutTxtXY(7,17,10,1,'Do you see how this mess of mine is actually working?');
sGotoXY(5,23); AnyKey;
END ELSE BEGIN
sWriteln('');
OutTxtL(12,0,'Sorry, ANSI Graphics Requires For This....');
sWriteln('');
AnyKey;
END;
'E' : RunEntryForm('QUEST1.FRM');
'F' : BEGIN
sClrScr; sGotoXY(1,1); Set_Color(0,7); sClrEol;
MenuBarItem(3,1,'M','ain Menu');
MenuBarItem(23,1,'F','ile Menu');
MenuBarItem(43,1,'E','-Mail Menu');
MenuBarItem(63,1,'S','ysOp Menu');
DrawMenu(2,2,20,10);
MenuItem(3,3,'F','irst Function');
MenuItem(3,4,'S','econd Function');
MenuItem(3,5,'T','hird Function');
MenuLine(2,6,19);
MenuItem(3,7,'A','nother Function');
MenuItem(3,8,'S','omthing Else');
MenuItem(3,9,'Q','uit This Menu');
OutTxtXY(2,13,10,0,'Since this door kit provides full support for local and remote cursor control');
OutTxtXY(2,14,10,0,'keys, you could create doors that have full drop down menus and windows that');
OutTxtXY(2,15,10,0,'can pop up whenever and wherever you need them. With this, you can provide');
OutTxtXY(2,16,10,0,'your users with a more "Natural" look and feel which will make it easier for');
OutTxtXY(2,17,10,0,'them to understand and use your doors. Using the cursor control keys to move');
OutTxtXY(2,18,10,0,'the cursor and menus around just seems to come naturally most people.');
sGotoXY(2,23); AnyKey;
END;
'G' : BEGIN
Set_Color(7,0); sClrScr;
OutTxtL(15,1,PadRight(' This is a test of the local and remote cursor control keys....',' ',79));
OutTxtL(11,1,PadRight(' Press ESC twice to exit. Use ^N and ^P to increment and decrement colors.',' ',79));
Set_Color(7,0); sClrEol;
Quit := FALSE;
MinX := 1; MaxX := 79; X := MinX;
MinY := 3; MaxY := LengthScr; Y := MinY;
REPEAT
sGotoXY(X,Y);
Ch := sReadKey;
CASE Ch OF
#0 : Str := s_ReadKey;
#22 : BEGIN
sWaitInput(250);
IF sKeyPressed THEN Str := Ch + sReadKey ELSE Str := Ch;
END;
#27 : BEGIN
Str := Ch;
Ch := sReadKey;
IF Ch = #27 THEN BEGIN
Quit := TRUE;
STR := '';
END ELSE Str := Str + Ch + sReadKey;
END;
^N : BEGIN
IF TextAttr AND $0f < 15 THEN INC(TextAttr) ELSE TextAttr := TextAttr AND $F0;
IF NOT Local THEN SendStr(AnsiColor);
END;
^P : BEGIN
IF TextAttr AND $0f > 0 THEN DEC(TextAttr) ELSE TextAttr := TextAttr AND $F0 OR $F;
IF NOT Local THEN SendStr(AnsiColor);
END;
#8 : IF X > MinX THEN BEGIN
DEC(X);
sWrite(#8+BackSpaceChar+#8);
END;
#1..#31:; {Scrap keys, just ignore them....}
ELSE BEGIN
IF X < MaxX THEN BEGIN
sWriteC(Ch);
INC(X);
END ELSE IF X = MaxX THEN sWriteC(Ch);
END;
END;
IF Str <> '' THEN FOR Loop := TTY TO AVATAR DO BEGIN
IF Str = CursorMove.Up[Loop] THEN BEGIN
DEC(Y);
Str := '';
END;
IF Str = CursorMove.Down[Loop] THEN BEGIN
INC(Y);
Str := '';
END;
IF Str = CursorMove.Left[Loop] THEN BEGIN
DEC(X);
Str := '';
END;
IF Str = CursorMove.Right[Loop] THEN BEGIN
INC(X);
Str := '';
END;
IF Str = CursorMove.Home[Loop] THEN BEGIN
X := MinX;
Str := '';
END;
IF Str = CursorMove.EndKey[Loop] THEN BEGIN
X := MaxX;
Str := '';
END;
END;
IF X > MaxX THEN X := MaxX;
IF Y > MaxY THEN Y := MaxY;
IF X < MinX THEN X := MinX;
IF Y < MinY THEN Y := MinY;
UNTIL Quit;
END;
END;
IF Ch <> 'Q' THEN ShowProgramAd;
UNTIL Ch = 'Q';
END.